home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / pcmag / vol7n22.arc / SIDEWRIT.BAS < prev   
BASIC Source File  |  1988-11-21  |  4KB  |  75 lines
  1. DEFINT A-Z
  2. DECLARE SUB SideWrite (Mot$, PosX, PosY, Couleur, Opt)  'this is for QB4 only
  3.  
  4. SCREEN 1                                            '320 x 200 x 4 graphics
  5. DIM Temp(13)                                        'holds upper left corner
  6. GET (0, 0)-(8, 7), Temp                             'save upper left corner
  7.  
  8. 'SCREEN 9                                           '640 x 350 x 16 graphics
  9. 'DIM Temp(57)
  10. 'GET (0, 0)-(8, 13), Temp
  11.  
  12. CALL SideWrite("Side Writing", 0, 120, 1, 1)              '90° up
  13. CALL SideWrite("Italic Side Writing", 20, 160, 2, 2)      '90° italic
  14. CALL SideWrite("Vertical Writing", 40, 10, 3, 3)          '0° down
  15. CALL SideWrite("Side Writing", 55, 10, 1, 4)              '270° down
  16. CALL SideWrite("Italic Side Writing", 73, 10, 2, 5)       '270° down italic
  17. CALL SideWrite("Big Side Writing", 90, 190, 3, 6)         'big 90° up
  18. CALL SideWrite("Big Italic Side Writing", 115, 190, 1, 7) 'big 90° up italic
  19. CALL SideWrite("Big Vertical Writing", 145, 10, 2, 8)     'big 0° down
  20. CALL SideWrite("Normal", 10, 0, 3, 9)                     '0°
  21. CALL SideWrite("Normal Italic", 70, 0, 1, 10)             '0° right italic
  22. CALL SideWrite("Big ", 180, 0, 2, 11)                     'big 0° right
  23. CALL SideWrite("Big Italic", 220, 0, 3, 12)               'big 0° right italic
  24. CALL SideWrite("All This DEMO", 180, 50, 1, 10)
  25. CALL SideWrite("was done", 195, 60, 2, 9)
  26. CALL SideWrite("--> with <--", 180, 76, 3, 11)
  27. CALL SideWrite("SideWrit.Bas!!", 180, 100, 1, 12)
  28. CALL SideWrite("______________", 180, 102, 1, 12)
  29.  
  30. PUT (0, 0), Temp, PSET                              'restore upper left corner
  31.  
  32. SUB SideWrite (Mot$, PosX, PosY, Couleur, Opt) STATIC
  33. FOR Nombre = 1 TO LEN(Mot$)
  34.     LOCATE 1, 1
  35.     PRINT MID$(Mot$, Nombre, 1)        'print word's letters one by one
  36.     FOR X = 0 TO 7
  37.       FOR Y = 0 TO 7                   'use 0 TO 13 for EGA
  38.         IF POINT(X, Y) THEN            'read pixel on/off for sideways copy
  39.            IF Opt = 1 THEN
  40.               PSET (Y + PosX, 8 - X + PosY - (8 * Nombre)), Couleur
  41.            ELSEIF Opt = 2 THEN
  42.               PSET (Y + PosX, 8 - X + PosY - (8 * Nombre) + Y), Couleur
  43.            ELSEIF Opt = 3 THEN
  44.               PSET (X + PosX, PosY + (8 * Nombre) + Y), Couleur
  45.            ELSEIF Opt = 4 THEN
  46.               PSET (8 - Y + PosX, PosY + (8 * Nombre) + X), Couleur
  47.            ELSEIF Opt = 5 THEN
  48.               PSET (8 - Y + PosX, PosY + (8 * Nombre) + X - Y), Couleur
  49.            ELSEIF Opt = 6 THEN
  50.               PSET (Y + PosX + Y, 8 - X + PosY - (8 * Nombre)), Couleur
  51.               PSET (1 + Y + PosX + Y, 8 - X + PosY - (8 * Nombre)), Couleur
  52.            ELSEIF Opt = 7 THEN
  53.               PSET (Y + PosX + Y, 8 - X + PosY - (8 * Nombre) + Y), Couleur
  54.               PSET (1 + Y + PosX + Y, 8 - X + PosY - (8 * Nombre) + Y), Couleur
  55.            ELSEIF Opt = 8 THEN
  56.               PSET (X + PosX + X, PosY + (8 * Nombre) + Y), Couleur
  57.               PSET (1 + X + PosX + X, PosY + (8 * Nombre) + Y), Couleur
  58.            ELSEIF Opt = 9 THEN
  59.               PSET (X + PosX + (Nombre * 8), PosY + Y), Couleur
  60.            ELSEIF Opt = 10 THEN
  61.               PSET (X + PosX + (Nombre * 8) - Y, PosY + Y), Couleur
  62.            ELSEIF Opt = 11 THEN
  63.               PSET (X + PosX + (Nombre * 8), PosY + Y + Y), Couleur
  64.               PSET (X + PosX + (Nombre * 8), 1 + PosY + Y + Y), Couleur
  65.            ELSEIF Opt = 12 THEN
  66.               PSET (X + PosX + (Nombre * 8) - Y, PosY + Y + Y), Couleur
  67.               PSET (X + PosX + (Nombre * 8) - Y, 1 + PosY + Y + Y), Couleur
  68.            END IF
  69.         END IF
  70.       NEXT Y
  71.     NEXT X
  72. NEXT Nombre
  73. END SUB
  74.  
  75.